home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / misc / test-sgc.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1994-05-07  |  1.4 KB  |  59 lines
  1. (in-package 'si)
  2. (or (fboundp 'get-usage) (load "/public/gcl/misc/rusage"))
  3. (gbc-time 0)
  4. (defun cv (x) (/ x (float INTERNAL-TIME-UNITS-PER-SECOND)))
  5. (defvar *all-times* nil)
  6. (defmacro with-timing (&rest forms)
  7.   `(let ((usg0 (get-usage t nil))
  8.     (t1 (gbc-time))
  9.     (t2 (get-internal-run-time))
  10.     (t3 (get-internal-real-time)))
  11.     (prog1 ,@forms
  12.       (setq t1 (- (gbc-time ) t1))
  13.       (setq t2 (-  (get-internal-run-time) t2))
  14.       (setq t3 (-  (get-internal-real-time) t3))
  15.       (let ((usg (get-usage t nil)))
  16.     (let ((ans
  17.            (format nil
  18.         "Run= ~3,2f Elap= ~3,2f Gc= ~3,2f Fault= ~3d"
  19.         (cv t2) (cv t3) (cv t1)
  20.         (- (|rusage|-|ru_majflt| usg) (|rusage|-|ru_majflt| usg0)))))
  21.       (push (list ',(car forms) ans ) *all-times*)
  22.       (print ans))))))
  23.  
  24.  
  25. (setq si::*notify-gbc* t)
  26. (allocate 'cons 520 t)
  27. (allocate 'fixnum 40)
  28.  
  29. (si::sgc-on nil)
  30. (si::allocate-sgc 'symbol 20  30 30)
  31. (si::allocate-sgc 'cons 50  3000 40)
  32.  
  33. (si::allocate-sgc 'vector 1 10 30)
  34. (si::allocate-sgc 'string 1 10 30)
  35. (gbc nil)
  36. (si::sgc-on t)
  37. (print (in-package "MAXIMA"))
  38. (setq $joe #$expand((x+y+z)^20)$)
  39.  
  40.  
  41. (defun test (form)
  42.   (gbc nil)
  43.   (eval form)
  44.   (push (list form 'cons-pages (si::allocated-pages 'cons)) si::*all-times*)
  45.   
  46.   (gbc nil)
  47.   (si::with-timing (sloop for i below 3 do (displa ($factor $joe))))
  48.   )
  49.  
  50. (test '(si::sgc-on nil))
  51. (test '(si::sgc-on t))
  52. (test '(si::sgc-on nil))
  53. (test '(si::sgc-on t))
  54.  
  55. (print si::*all-times*)
  56.       
  57.       
  58.     
  59.